home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d27 / creatopt.arc / PGMRCREA.CLP < prev    next >
Text File  |  1991-12-04  |  10KB  |  135 lines
  1. /*      CRTOPT PUBAUT(*ALL)                                          */         
  2. /*********************************************************************/         
  3. /* PROGRAM-             PGMRCREAT                                    */         
  4. /* AUTHOR-              GREG THIELEN                                 */         
  5. /* DATE WRITTEN-        MARCH 7, 1988                                */         
  6. /* PROGRAM DESCRIPTION- BATCH OBJECT CREATION PROCESSOR FOR          */         
  7. /*                      PGMREXIT.                                    */         
  8. /*********************************************************************/         
  9.              PGM        PARM(&RQS)                                              
  10.              DCL        VAR(&RQS) TYPE(*CHAR) LEN(239)                          
  11.              DCL        VAR(&SRCFILE) TYPE(*CHAR) LEN(10)                       
  12.              DCL        VAR(&SRCLIB) TYPE(*CHAR) LEN(10)                        
  13.              DCL        VAR(&SRCMBR) TYPE(*CHAR) LEN(10)                        
  14.              DCL        VAR(&RQSLEN) TYPE(*DEC) LEN(3 0)                        
  15.              DCL        VAR(&CRTCMD) TYPE(*CHAR) LEN(2000)                      
  16.              DCL        VAR(&CMDLEN) TYPE(*DEC) LEN(4 0)                        
  17.              DCL        VAR(&CMDINX) TYPE(*DEC) LEN(4 0)                        
  18.              DCL        VAR(&OPTID) TYPE(*CHAR) LEN(6)                          
  19.              DCL        VAR(&OPTION) TYPE(*CHAR) LEN(50)                        
  20.              DCL        VAR(&OPTINX) TYPE(*DEC) LEN(2 0)                        
  21.              DCL        VAR(&OPTBEG) TYPE(*DEC) LEN(2 0)                        
  22.              DCL        VAR(&OPTLEN) TYPE(*DEC) LEN(2 0)                        
  23.              DCL        VAR(&KWDLEN) TYPE(*DEC) LEN(2 0)                        
  24.              DCL        VAR(&RQSMSG) TYPE(*CHAR) LEN(256)                       
  25.              DCL        VAR(&MSGLEN) TYPE(*DEC) LEN(3 0)                        
  26.              DCL        VAR(&MSGID) TYPE(*CHAR) LEN(7)                          
  27.              DCL        VAR(&MSGF) TYPE(*CHAR) LEN(10)                          
  28.              DCL        VAR(&MSGFLIB) TYPE(*CHAR) LEN(10)                       
  29.              DCL        VAR(&MSGDTA) TYPE(*CHAR) LEN(256)                       
  30.              DCL        VAR(&OPT_FOUND) TYPE(*LGL)                              
  31.              DCLF       FILE(QCLSRC)                                            
  32.              CHGVAR     VAR(&SRCFILE) VALUE(%SST(&RQS 1 10))                    
  33.              CHGVAR     VAR(&SRCLIB) VALUE(%SST(&RQS 11 10))                    
  34.              CHGVAR     VAR(&SRCMBR) VALUE(%SST(&RQS 21 10))                    
  35.              CHGVAR     VAR(&RQSLEN) VALUE(%SST(&RQS 31 3))                     
  36.              CHGVAR     VAR(&CRTCMD) VALUE(%SST(&RQS 34 &RQSLEN))               
  37.              CHGVAR     VAR(&CMDLEN) VALUE(&RQSLEN)                             
  38.              OVRDBF     FILE(QCLSRC) TOFILE(&SRCFILE.&SRCLIB) +                 
  39.                           MBR(&SRCMBR) LVLCHK(*NO)                              
  40.  RCVF:       RCVF                                                               
  41.              MONMSG     MSGID(CPF0000) EXEC(GOTO CMDLBL(SNDCRTRQS))             
  42.              CHGVAR     VAR(&OPTID) VALUE(%SST(&SRCDTA 9 6))                    
  43.              CHGVAR     VAR(&OPTION) VALUE(%SST(&SRCDTA 16 50))                 
  44.              IF         COND(&OPTID *EQ 'CRTOPT') THEN(GOTO +                   
  45.                           CMDLBL(CRTOPT))                                       
  46.              IF         COND(&OPTID *EQ 'CRTCMD') THEN(GOTO +                   
  47.                           CMDLBL(CRTCMD))                                       
  48.              GOTO       CMDLBL(SNDCRTRQS)                                       
  49. /*********************************************************************/         
  50. /* EXTRACT CREATE OPTIONS                                            */
  51. /*********************************************************************/
  52.  CRTOPT:     CHGVAR     VAR(&OPTINX) VALUE(1)                                   
  53.  GETOPTBEG:    /* Get beginning position of create option */
  54.                IF         COND(%SST(&OPTION &OPTINX 1) *EQ ' ') +                 
  55.                           THEN(DO)                                              
  56.                IF         COND(&OPTINX *GE 50) THEN(GOTO CMDLBL(RCVF))          
  57.                CHGVAR     VAR(&OPTINX) VALUE(&OPTINX + 1)                       
  58.                GOTO       CMDLBL(GETOPTBEG)                                     
  59.              ENDDO                                                              
  60.              CHGVAR     VAR(&OPTBEG) VALUE(&OPTINX)
  61.  
  62.  GETKWDLEN:    /* Get keyword length */
  63.                IF         COND(%SST(&OPTION &OPTINX 1) *NE '(') +                 
  64.                           THEN(DO)                                              
  65.                IF         COND(&OPTINX *GE 50) THEN(GOTO CMDLBL(RCVF))          
  66.                CHGVAR     VAR(&OPTINX) VALUE(&OPTINX + 1)                       
  67.                GOTO       CMDLBL(GETKWDLEN)                                     
  68.              ENDDO                                                              
  69.              CHGVAR     VAR(&KWDLEN) VALUE(&OPTINX - &OPTBEG + 1)
  70.              /* Check for create option (keyword) already contained in +
  71.                 submitted command string */
  72.              CHGVAR     VAR(&OPT_FOUND) VALUE('0')                              
  73.              CHGVAR     VAR(&CMDINX) VALUE(1)                                   
  74.  FINDOPT:    IF         COND(%SST(&CRTCMD &CMDINX &KWDLEN) *EQ +                
  75.                           %SST(&OPTION &OPTBEG &KWDLEN)) THEN(CHGVAR +          
  76.                           VAR(&OPT_FOUND) VALUE('1'))                           
  77.              ELSE       CMD(DO)                                                 
  78.                IF         COND(&CMDINX *LE (&CMDLEN - &OPTLEN)) THEN(DO)        
  79.                  CHGVAR     VAR(&CMDINX) VALUE(&CMDINX + 1)                     
  80.                  GOTO       CMDLBL(FINDOPT)                                     
  81.                ENDDO                                                            
  82.              ENDDO
  83.              IF         COND(*NOT &OPT_FOUND) THEN(DO)
  84.                /* Get last position of create option */
  85.                CHGVAR     VAR(&OPTINX) VALUE(50)                                
  86.  GETOPTEND:    IF         COND(%SST(&OPTION &OPTINX 1) *EQ ' ') +               
  87.                             THEN(DO)                                            
  88.                  CHGVAR     VAR(&OPTINX) VALUE(&OPTINX - 1)                     
  89.                  GOTO       CMDLBL(GETOPTEND)                                   
  90.                ENDDO
  91.                /* Append create option to submitted create command +
  92.                   if enough room */
  93.                CHGVAR     VAR(&OPTLEN) VALUE(&OPTINX - &OPTBEG + 1)             
  94.                IF         COND((&CMDLEN + &OPTLEN + 1) *LE 2000) THEN(DO)       
  95.                  CHGVAR     VAR(&CRTCMD) VALUE(&CRTCMD │> %SST(&OPTION +        
  96.                               &OPTBEG &OPTLEN))                                 
  97.                  CHGVAR     VAR(&CMDLEN) VALUE(&CMDLEN + &OPTLEN + 1)           
  98.                ENDDO                                                            
  99.              ENDDO                                                              
  100.              GOTO       CMDLBL(RCVF)                                            
  101. /*********************************************************************/
  102. /* EXTRACT CREATE COMMANDS                                           */
  103. /*********************************************************************/
  104.  CRTCMD:     SNDPGMMSG  MSG(&OPTION) TOPGMQ(*EXT) MSGTYPE(*RQS)                 
  105.              GOTO       CMDLBL(RCVF)                                            
  106. /*********************************************************************/
  107. /* SEND CREATE COMMAND REQUEST MESSAGE (in 255 byte increments       */
  108. /*                                      if required)                 */
  109. /*********************************************************************/
  110.  SNDCRTRQS:  CHGVAR     VAR(&CMDINX) VALUE(1)                                   
  111.  GETRQS:     IF         COND(&CMDINX *LE &CMDLEN) THEN(DO)                      
  112.                CHGVAR     VAR(&MSGLEN) VALUE(&CMDLEN - &CMDINX + 1)             
  113.                IF         COND(&MSGLEN *GT 256) THEN(DO)                        
  114.                  CHGVAR     VAR(&MSGLEN) VALUE(255)                             
  115.                  CHGVAR     VAR(&RQSMSG) VALUE(%SST(&CRTCMD &CMDINX 255) +      
  116.                               ││ '-')                                           
  117.                ENDDO                                                            
  118.                ELSE       CMD(CHGVAR VAR(&RQSMSG) VALUE(%SST(&CRTCMD +          
  119.                             &CMDINX &MSGLEN)))                                  
  120.                SNDPGMMSG  MSG(&RQSMSG) TOPGMQ(*EXT) MSGTYPE(*RQS)               
  121.                CHGVAR     VAR(&CMDINX) VALUE(&CMDINX + &MSGLEN)                 
  122.                GOTO       CMDLBL(GETRQS)                                        
  123.              ENDDO
  124. /*********************************************************************/
  125. /* EXECUTE REQUEST MESSAGES (commands)                               */
  126. /*********************************************************************/
  127.              TFRCTL     PGM(QCL)                                                
  128. /*********************************************************************/         
  129.  RCVERRMSG:  RCVMSG     MSGTYPE(*EXCP) MSGDTA(&MSGDTA) MSGID(&MSGID) +          
  130.                           MSGF(&MSGF) MSGFLIB(&MSGFLIB)                         
  131.              IF         COND(&MSGID *NE ' ') THEN(SNDPGMMSG +                   
  132.                           MSGID(&MSGID) MSGF(&MSGF.&MSGFLIB) +                  
  133.                           MSGDTA(&MSGDTA) MSGTYPE(*ESCAPE))                     
  134.              ENDPGM                                                             
  135.